home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_lib.lha / oberon-a / source3.lha / source / EAGUI / EALabels.mod < prev    next >
Text File  |  1995-06-29  |  8KB  |  253 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: EALabels.mod $
  4.   Description: Text label images for EAGUI.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.2 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:20:09 $
  10.  
  11.   Copyright © 1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18. <*$ StackChk- *>
  19. <*$ ReturnChk- *>
  20. <*$ LongVars+ *>
  21.  
  22. MODULE EALabels;
  23.  
  24. IMPORT
  25.   SYS := SYSTEM, Kernel, s := Sets, e := Exec, u := Utility,
  26.   gfx := Graphics, i := Intuition, ea := EAGUI;
  27.  
  28. CONST
  29.  
  30. (* Alternative alignment flags. If these aren't specified, the default is
  31.  * to center the textfield both horizontally and vertically.
  32.  *)
  33.  
  34.   AlignLeft *   = 0;
  35.   AlignRight *  = 1;
  36.   AlignTop *    = 2;
  37.   AlignBottom * = 3;
  38.  
  39. (* Rendering style flags. If not specified, the text is rendered as
  40.  * plain JAM1 text with the default text pen.
  41.  *)
  42.  
  43.   ShadowText *  = 4; (* Rendered in the default shine pen over an offset
  44.                       * shadow in the default shadow pen.
  45.                       *)
  46.  
  47. TYPE
  48.  
  49. (* Information that is needed by this object, but that isn't maintained
  50.  * by EAGUI itself.
  51.  *)
  52.  
  53.   LabelPtr * = POINTER [2] TO Label;
  54.   Label * = RECORD [2]
  55.     text *       : e.LSTRPTR;       (* string that is displayed *)
  56.     textAttr *   : gfx.TextAttrPtr; (* font that is used *)
  57.     flags *      : s.SET32;         (* different flags *)
  58.     frontPen *,
  59.     backPen *    : e.UBYTE;         (* pens to use *)
  60.     drawMode *   : s.SET8;          (* draw mode to use *)
  61.   END;
  62.  
  63. VAR
  64.  
  65.   MinSizeHook *, RenderHook * : u.HookPtr;
  66.   hook1, hook2 : u.Hook;
  67.   itext1, itext2 : i.IntuiText;
  68.  
  69.  
  70. (*************************************************************************
  71. *                                                                        *
  72. * MinSize Method                                                         *
  73. *                                                                        *
  74. *************************************************************************)
  75.  
  76. PROCEDURE MinSize*
  77.   ( hook : u.HookPtr;
  78.     obj  : ea.OPTR;
  79.     msg  : e.APTR )
  80.   : e.ULONG;
  81.  
  82.   VAR
  83.     minwidth, minheight, ignore : LONGINT;
  84.     lbl : LabelPtr;
  85.  
  86.   BEGIN (* MinSize *)
  87.     (* get a pointer to our structure, and check if we actually got it *)
  88.     lbl := SYS.VAL (LabelPtr, ea.GetAttr (obj, ea.UserData));
  89.     IF lbl # NIL THEN
  90.       (* now, we use the library to determine the dimensions of the string *)
  91.       minwidth := ea.TextLengthPtr (lbl.textAttr, lbl.text, 0X);
  92.       minheight := ea.TextHeightPtr (lbl.textAttr);
  93.       IF ShadowText IN lbl.flags THEN
  94.         INC (minwidth, 2); INC (minheight)
  95.       END;
  96.  
  97.       (* and finally, we set these values *)
  98.       ignore := ea.SetAttr (obj, ea.MinWidth, minwidth);
  99.       ignore := ea.SetAttr (obj, ea.MinHeight, minheight);
  100.     END;
  101.     (* we always return success *)
  102.     RETURN 0
  103.   END MinSize;
  104.  
  105. (*************************************************************************
  106. *                                                                        *
  107. * Render Method                                                          *
  108. *                                                                        *
  109. *************************************************************************)
  110.  
  111. PROCEDURE Render*
  112.   ( hook : u.HookPtr;
  113.     obj  : ea.OPTR;
  114.     rm   : ea.RenderMessagePtr )
  115.   : e.ULONG;
  116.  
  117.   VAR
  118.     lbl : LabelPtr;
  119.     minwidth, minheight, width, height, left, top, ignore : e.ULONG;
  120.  
  121.   BEGIN (* Render *)
  122.     (* get a pointer to our structure, and check if we actually got it *)
  123.     lbl := SYS.VAL (LabelPtr, ea.GetAttr (obj, ea.UserData));
  124.     IF lbl # NIL THEN
  125.       (* get sizes of the object *)
  126.       ignore := ea.GetAttrs ( obj,
  127.                               ea.MinWidth,  SYS.ADR (minwidth),
  128.                               ea.MinHeight, SYS.ADR (minheight),
  129.                               ea.Width,     SYS.ADR (width),
  130.                               ea.Height,    SYS.ADR (height),
  131.                               u.done );
  132.  
  133.       (* get offsets of object relative to root (window) *)
  134.       left := ea.GetObjectLeft (rm.root_ptr, obj);
  135.       top := ea.GetObjectTop (rm.root_ptr, obj);
  136.  
  137.       (* now align the object *)
  138.       IF (AlignRight IN lbl.flags) THEN
  139.         INC (left, (width - minwidth));
  140.       ELSIF (~(AlignLeft IN lbl.flags)) THEN
  141.         INC (left, (width - minwidth) DIV 2);
  142.       END;
  143.       IF (AlignBottom IN lbl.flags) THEN
  144.         INC (top, (height - minheight))
  145.       ELSIF (~(AlignTop IN lbl.flags)) THEN
  146.         INC (top, (height - minheight) DIV 2);
  147.       END;
  148.  
  149.       (* and finally render it *)
  150.       IF ShadowText IN lbl.flags THEN
  151.         itext1.iTextFont := lbl.textAttr;
  152.         itext1.iText := lbl.text;
  153.         itext1.frontPen := lbl.backPen;
  154.         itext1.drawMode := lbl.drawMode;
  155.         itext2.iTextFont := lbl.textAttr;
  156.         itext2.iText := lbl.text;
  157.         itext2.frontPen := lbl.frontPen;
  158.         itext2.drawMode := gfx.jam1;
  159.         i.PrintIText (rm.rastport_ptr, itext1, left, top)
  160.       ELSE
  161.         itext2.iTextFont := lbl.textAttr;
  162.         itext2.iText := lbl.text;
  163.         itext2.frontPen := lbl.frontPen;
  164.         itext1.drawMode := lbl.drawMode;
  165.         i.PrintIText (rm.rastport_ptr, itext2, left, top)
  166.       END
  167.     END;
  168.     (* return success *)
  169.     RETURN 0
  170.   END Render;
  171.  
  172. (*************************************************************************
  173. *                                                                        *
  174. * Constructors                                                           *
  175. *                                                                        *
  176. *************************************************************************)
  177.  
  178. PROCEDURE xNewLabel () : ea.OPTR;
  179.  
  180. BEGIN (* xNewLabel *)
  181.   SYS.SETREG (0,
  182.       ea.NewObject ( ea.TYPE_CUSTOMIMAGE,
  183.           ea.MinSizeMethod, MinSizeHook,
  184.           ea.RenderMethod,  RenderHook,
  185.           ea.UserData,      SYS.REG (8), (* lbl *)
  186.           u.more,           SYS.REG (9), (* tags *)
  187.           u.done ))
  188. END xNewLabel;
  189.  
  190. PROCEDURE [4] NewLabel* ["EALabels_xNewLabel"]
  191.   ( VAR lbl [8] : Label;
  192.     tags [9]..  : u.Tag )
  193.   : ea.OPTR;
  194.  
  195. PROCEDURE [4] NewLabelA* ["EALabels_xNewLabel"]
  196.   ( VAR lbl [8] : Label;
  197.     tags [9]    : u.TagListPtr )
  198.   : ea.OPTR;
  199.  
  200. PROCEDURE InitLabel*
  201.   ( VAR lbl  : Label;
  202.     text     : e.LSTRPTR;
  203.     textAttr : gfx.TextAttrPtr;
  204.     drawMode : s.SET8;
  205.     flags    : s.SET32;
  206.     drawInfo : i.DrawInfoPtr );
  207.  
  208. BEGIN (* InitLabel *)
  209.   lbl.text := text;
  210.   lbl.textAttr := textAttr;
  211.   lbl.flags := flags;
  212.   lbl.drawMode := drawMode;
  213.   IF drawInfo # NIL THEN
  214.     IF ShadowText IN flags THEN
  215.       lbl.frontPen := SHORT (drawInfo.pens [i.shinePen]);
  216.       lbl.backPen := SHORT (drawInfo.pens [i.shadowPen])
  217.     ELSE
  218.       lbl.frontPen := SHORT (drawInfo.pens [i.textPen]);
  219.       lbl.backPen := SHORT (drawInfo.pens [i.backGroundPen])
  220.     END
  221.   ELSE
  222.     IF ShadowText IN flags THEN
  223.       lbl.frontPen := 2;
  224.       lbl.backPen := 1
  225.     ELSE
  226.       lbl.frontPen := 1;
  227.       lbl.backPen := 0
  228.     END
  229.   END
  230. END InitLabel;
  231.  
  232.  
  233. (************************************************************************)
  234.  
  235. <*$ LongVars- *>
  236.  
  237. PROCEDURE Init;
  238. BEGIN (* Init *)
  239.   MinSizeHook := SYS.ADR (hook1); RenderHook := SYS.ADR (hook2);
  240.   u.InitHook (MinSizeHook, SYS.VAL (u.HookFunc, MinSize));
  241.   u.InitHook (RenderHook, SYS.VAL (u.HookFunc, Render));
  242.  
  243.   (* Assuming uninitialised fields are zeroed... *)
  244.   itext1.leftEdge := 2; itext1.topEdge := 1;
  245.   itext1.frontPen := 1; itext1.drawMode := gfx.jam1;
  246.   itext1.nextText := SYS.ADR (itext2);
  247.   itext2.frontPen := 2; itext2.drawMode := gfx.jam1
  248. END Init;
  249.  
  250. BEGIN
  251.   Init
  252. END EALabels.
  253.